Cookbook for MCA

#Clear Workspace----
rm(list = ls())

#Data Cleaning—-

#Import data----
PHQ <- read.csv("~/Desktop/[Group1_TheodoreWiebold]MCA-PHQ/PHQdata.csv", header = TRUE, sep = "", quote="\"", row.names = NULL)
#header = TRUE makes first row the header
#sep = "", quote = "\"" will maintain the variabels and columns and remove the " "
rawobservations <- nrow(PHQ) #shows number of observations from raw dataset

#Remove rows with missing data----
PHQ <- na.omit(PHQ) #omits rows with no values
naomitobservations <- nrow(PHQ) #shows number of observations from naomit data
naomit <- rawobservations - naomitobservations #shows number of observations removed 

#Remove duplicates after the first attempt----
n_occurWithDuplicates <- data.frame(table(PHQ$row.names)) #gives a dataframe of how many times each id occured in the data
NumberOfDubplicates <- sum(n_occurWithDuplicates$Freq-1) #gives the number of duplicates, if more 0 remove # from beginning of loop
#for (i in 1:NumberOfDubplicates) { #for-loop removing duplicates
#y <- anyDuplicated(PHQ$row.names)
#PHQ <- PHQ[-y,]
#   }
n_occurNoDuplicates <- data.frame(table(PHQ$row.names))  #shows there are no duplicates reamining

#Remove columns and rows with string identifiers----
#PHQ <- PHQ[,-1] #removes first column of id numbers
GroupingVaribles <- PHQ[,c(2,3,4,5)] #creates a grouping variable matrix
PHQ <- PHQ[,c(-1, -2, -3, -4, -5)] #removes columns of grouping variables 
totalscore <- rowSums(PHQ) 

#Creat grouping based on Depression Severity----
for (i in 1:length(totalscore)){
severity <- totalscore[i]
  if (severity <= 18){
  totalscore[i] <- 1 #minimal symptoms
  }
  if (severity > 18 & severity <= 23){
  totalscore[i] <- 2 #major depression, mild
  }
  if (severity > 23 & severity <= 28){
  totalscore[i] <- 3 #major depression, moderately severe
  }
  if (severity >28){
  totalscore[i] <- 4 #major depression, severe
  }
}
SeverityLabel <- c("Minimal Symptoms", "Mild", "Moderately Severe", "Severe")

#Make key words as each variable representing each question in PHQ9----
colnames(PHQ) <- c('Pleasure','Hopeless','Sleep','Energy','Appetite','Failure','Focus','Speed','Suicide')


#Convert character to numeric in all columns----
PHQ[ , c(1:ncol(PHQ))] <- apply(PHQ[ , c(1:ncol(PHQ))], 2, function(x) as.numeric(as.character(x)))

#Convert to MCA

library(TExPosition)
# Have a look and create empty SamplesMatrix and MCAdata
Question <- colnames(PHQ)[1:9]
BinMatrix <- matrix(, nrow = 9, ncol = 4)
row.names(BinMatrix) <- Question
colnames(BinMatrix) <- c("Bin 1 (1)", "Bin 2 (2)", "Bin 3 (3/4)", "Spearman")
MCAdata <- matrix(, nrow = 225, ncol = 9)
colnames(MCAdata) <- Question
row.names(MCAdata) <- c(1:225)

##Create BinMatrix and MCAdata
for (i in 1:9) {
  if (i <= 8){
    recode <- cut(PHQ[,i],breaks = c(min(PHQ[,1]),1.5,2,max(PHQ[,i])+1),include.lowest = T)
    
    #Fills MCAdata
    MCAdata[,i] <- recode
    
    #Fills BinMatrix (binned according to PHQ tool)
    populate <- data.frame(table(recode))
    populate <- t(populate$Freq)
    BinMatrix[i,1:3] <- populate
    BinMatrix[i,4] <- cor(PHQ[,i],as.numeric(recode), method = "spearman")
    
    #Creates histograms with bin lines
    Distribution <-hist(PHQ[,i], breaks = 8, col = c(rgb(48, 90, 191, 125, maxColorValue=255), rgb(132, 191, 48, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255)), main = paste("Histogram of", colnames(PHQ)[i]), xlab = "Question Answer")
    
Distribution <- abline(v = c(1.5,2), col = "red")
    
Distribution <- legend("topright", legend = c(c(colnames(BinMatrix)[1],BinMatrix[i,1]), c(colnames(BinMatrix)[2],BinMatrix[i,2]), c(colnames(BinMatrix)[3], BinMatrix[i,3]), c(colnames(BinMatrix)[4], round(BinMatrix[i,4], digits = 4))),pch = 16, pt.cex = 2, cex = .75, bty = 'n', col =c(rgb(48, 90, 191, 125, maxColorValue=255), NA, rgb(132, 191, 48, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255), NA, NA, NA))
  } else {
     recode <- cut(PHQ[,i],breaks = c(min(PHQ[,1]),1.5,max(PHQ[,i])+1),include.lowest = T)
    
     #Fills MCAdata
     MCAdata[,i] <- recode 
    
     #Fills BinMatrix (Binned according to PHQ tool)
     populate <- data.frame(table(recode))
    populate <- t(populate$Freq)
    BinMatrix[i,1:2] <- populate
    BinMatrix[i,3] <- NA
    BinMatrix[i,4] <- cor(PHQ[,i],as.numeric(recode), method = "spearman")
    
    #Creates histogram with bin line and legend
    Distribution <-hist(PHQ[,i], breaks = 8, col = c(rgb(48, 90, 191, 125, maxColorValue=255), c(rgb(191, 48, 173, 125, maxColorValue=255), rgb(191, 48, 173, 125, maxColorValue=255), rgb(191, 48, 173, 125, maxColorValue=255))), main = paste("Histogram of", colnames(PHQ)[i]), xlab = "Question Answer")
   
    Distribution <- legend("topright", legend = c(c(colnames(BinMatrix)[1],BinMatrix[i,1]), c(colnames(BinMatrix)[2],BinMatrix[i,2]), c(colnames(BinMatrix)[4], round(BinMatrix[i,4], digits = 4))),pch = 16, pt.cex = 2, cex = .75, bty = 'n', col =c(rgb(48, 90, 191, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255), NA, NA, NA))
  
    Distribution <- abline(v = 1.5, col = "red")  
  }
}

#BinMatrix
## Look at the variables ----
#hist.Pleasure <- hist(PHQ[,1], breaks = 20,  main = paste("Histogram of", colnames(PHQ)[1]))
#Pleasure_recode <- cut(PHQ[,1],breaks = c(min(PHQ[,1]),1.5,2,max(PHQ[,1])+1),include.lowest = T)
#Pleasure <- data.frame(table(Pleasure_recode))
#Pleasure <- t(Pleasure$Freq)
# check the spearman's rank correlation
#PleasureCor <- cor(PHQ[,1],as.numeric(Pleasure_recode), method = "spearman")

#hist.Hopeless <- hist(PHQ[,2], breaks = 20,  main = paste("Histogram of", colnames(PHQ)[2]))
#Hopeless_recode <- cut(PHQ[,2],breaks = c(min(PHQ[,2]),1.5,2,max(PHQ[,2])+1),include.lowest = T)
#table(Hopeless_recode)
# check the spearman's rank correlation
#cor(PHQ[,2],as.numeric(Hopeless_recode), method = "spearman")

#hist.Sleep <- hist(PHQ[,3], breaks = 20,  main = paste("Histogram of", colnames(PHQ)[3]))
#Sleep_recode <- cut(PHQ[,1],breaks = c(min(PHQ[,1]),1.5,2,max(PHQ[,1])+1),include.lowest = T)
#table(Pleasure_recode)
# check the spearman's rank correlation
#cor(PHQ[,1],as.numeric(Pleasure_recode), method = "spearman")

#hist.Energy <- hist(PHQ[,4], breaks = 20,  main = paste("Histogram of", colnames(PHQ)[4]))
#hist.Appetite <- hist(PHQ[,5], breaks = 20,  main = paste("Histogram of", colnames(PHQ)[5]))
#hist.Failure <- hist(PHQ[,6], breaks = 20,  main = paste("Histogram of", colnames(PHQ)[6]))
#hist.Focus <- hist(PHQ[,7], breaks = 20, main = paste("Histogram of", colnames(PHQ)[7]))
#hist.Speed <- hist(PHQ[,8], breaks = 20, main = paste("Histogram of", colnames(PHQ)[8]))

#hist.Suicide <- hist(PHQ[,9], breaks = 20, main = paste("Histogram of", colnames(PHQ)[9]))
#Suicide_recode <- cut(PHQ[,9],breaks = c(min(PHQ[,9]),1.5,max(PHQ[,9])+1),include.lowest = T)
#Suicide <- data.frame(table(Suicide_recode))
#Suicide <- t(Suicide$Freq)
# check the spearman's rank correlation
#SuicideCor <- cor(PHQ[,9],as.numeric(Suicide_recode), method = "spearman")
#hist.Pleasure
#hist.Hopeless
#hist.Sleep
#hist.Energy
#hist.Appetite
#hist.Failure
#hist.Focus
#hist.Speed
#hist.Suicide

Data set: PHQ

It measures the 9 different beers (rows) on 30 beer characteristics (columns).

head(MCAdata, n = 6L)

##   Pleasure Hopeless Sleep Energy Appetite Failure Focus Speed Suicide
## 1        1        1     2      3        1       1     1     1       1
## 2        1        1     1      2        1       1     1     1       1
## 3        1        1     1      1        1       1     1     1       1
## 4        1        3     3      2        3       2     1     1       1
## 5        1        1     1      1        1       1     1     1       1
## 6        1        2     3      3        1       3     2     1       1

#Heatmap of Loadings

#MCA heat map
corrMatBurt.list <- phi2Mat4BurtTable(MCAdata)
cor.plot.numPhi22 <- corrplot(as.matrix(corrMatBurt.list$phi2.mat), method = "number", type = "upper", tl.pos = "lt", tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cor.plot.fullPhi22 <- corrplot(as.matrix(corrMatBurt.list$phi2.mat), method = "ellipse", type = "lower", add = TRUE,
                          diag = FALSE, tl.pos = "n", cl.pos = "n")

a0001a.corMat.phi2 <- recordPlot()

# We need correlation to compare with PCA
corrMatBurt.list <- phi2Mat4BurtTable(MCAdata)
cor.plot.numPhi2 <- corrplot(as.matrix(sqrt(corrMatBurt.list$phi2.mat)), method = "number", type = "upper", tl.pos = "lt", tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cor.plot.fullPhi2 <- corrplot(as.matrix(sqrt(corrMatBurt.list$phi2.mat)), method = "ellipse", type = "lower", add = TRUE,
                          diag = FALSE, tl.pos = "n", cl.pos = "n")

a0001b.corMat.phi <- recordPlot()

#PHQ data Factor Table
cov.plot.PHQ <-cov(PHQ)
diag(cov.plot.PHQ) <- 1
cov.plot.numPHQ <- corrplot(cov.plot.PHQ, method = "number", type = "upper", tl.pos = "lt",
                        tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cov.plot.fullPHQ <- corrplot(cov.plot.PHQ, method = "ellipse", type = "lower", add = TRUE,
                          diag = FALSE, tl.pos = "n", cl.pos = "n")

#MCAdata Factor Table
cov.plot.MCAdata <-cov(MCAdata)
diag(cov.plot.MCAdata) <- 1
cov.plot.MCAdata <- corrplot(cov.plot.MCAdata, method = "number", type = "upper", tl.pos = "lt",
                        tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cov.plot.fullMCAdata <- corrplot(cov.plot.MCAdata, method = "ellipse", type = "lower", add = TRUE,
                          diag = FALSE, tl.pos = "n", cl.pos = "n")

#Correlate MCAdata and PHQ
cor.plot.dataBoth <-cor(PHQ, MCAdata, method = "spearman")
#diag(cov.plot.dataPHQ9) <- 1
cor.plot.numBoth <- corrplot(cor.plot.dataBoth, method = "number", type = "full", tl.pos = "lt", number.cex = 1, tl.cex = .9, tl.srt = 45, addCoefasPercent = TRUE)

Analysis

resPCA <- epPCA(MCAdata,
                scale = FALSE, # Make to use 'SS1' rather than TRUE
                DESIGN = totalscore,
                graphs =  FALSE)

MCAdata <- makeNominalData(MCAdata)
resMCA <- epMCA(MCAdata,
                make_data_nominal = FALSE,
                DESIGN = totalscore,
                graphs = FALSE)

The Data Pattern

ColorTheme <- prettyGraphsColorSelection(n.colors = 9)

# contributions for variables
ctrK <- ctr4Variables(resMCA$ExPosition.Data$cj)

for (j in 1:ncol(ctrK)) {
  ctrK1 <- ctrK[,j]
  names(ctrK1) <- rownames(ctrK) 
  a0005.Var.ctr1 <- PrettyBarPlot2(ctrK1,
    main = paste("Variable Contributions: ", colnames(ctrK)[j]), ylim = c(-.05, 1.2*max(ctrK1)),
  font.size = 5,
  threshold = 1 / nrow(ctrK), 
  color4bar = gplots::col2hex(ColorTheme)
  )
print(a0005.Var.ctr1)
}

## Inference

resMCA.inf <- InPosition::epMCA.inference.battery(MCAdata,
                                make_data_nominal = FALSE,                  
                                DESIGN = totalscore,
                                graphs =  FALSE) # TRUE first pass only

## [1] "It is estimated that your iterations will take 0.02 minutes."
## [1] "R is not in interactive() mode. Resample-based tests will be conducted. Please take note of the progress bar."
## ===========================================================================

#Scree Plot

scree.mca <- PlotScree(ev = resMCA$ExPosition.Data$eigs,
p.ev = resMCA.inf$Inference.Data$components$p.vals,
               plotKaiser = TRUE,
               title = "MCA Explained Variance per Dimension")

#Permutation Tests for Significant Eigenvalues

zeDim = 1
pH1 <- prettyHist(
  distribution = resMCA.inf$Inference.Data$components$eigs.perm[,zeDim], 
           observed = resMCA.inf$Fixed.Data$ExPosition.Data$eigs[zeDim], 
           xlim = c(.001, .25), # needs to be set by hand
           breaks = 20,
           border = "white", 
           main = paste0("Permutation Test for Eigenvalue ",zeDim),
           xlab = paste0("Eigenvalue ",zeDim), 
           ylab = "", 
           counts = FALSE, 
           cutoffs = c( 0.975))

eigs1 <- recordPlot()
zeDim = 2
pH2 <- pH1 <- prettyHist(
  distribution = resMCA.inf$Inference.Data$components$eigs.perm[,zeDim], 
           observed = resMCA.inf$Fixed.Data$ExPosition.Data$eigs[zeDim], 
           xlim = c(.001, .0325), # needs to be set by hand
           breaks = 20,
           border = "white", 
           main = paste0("Permutation Test for Eigenvalue ",zeDim),
           xlab = paste0("Eigenvalue ",zeDim), 
           ylab = "", 
           counts = FALSE, 
           cutoffs = c(0.975))

eigs2 <- recordPlot()
zeDim = 3
pH1 <- prettyHist(
  distribution = resMCA.inf$Inference.Data$components$eigs.perm[,zeDim], 
           observed = resMCA.inf$Fixed.Data$ExPosition.Data$eigs[zeDim], 
           xlim = c(.001, .0065), # needs to be set by hand
           breaks = 20,
           border = "white", 
           main = paste0("Permutation Test for Eigenvalue ",zeDim),
           xlab = paste0("Eigenvalue ",zeDim), 
           ylab = "", 
           counts = FALSE, 
           cutoffs = c( 0.975))

eigs1 <- recordPlot()

Row Factor Scores

#Legend
#Makes the legend for graph----
Legend <- plot(NULL, xaxt = 'n', yaxt = 'n', bty = 'n', ylab = '', xlab = '', xlim = 0:1, ylim = 0:1)
Legend <- legend("topleft", legend = c("Minimal Symptoms", "Mild", "Moderately Severe", "Severe"),pch = 16, pt.cex = 2, cex = .75, bty = 'n', col =c(rgb(48, 90, 191, 125, maxColorValue=255), rgb(191, 48, 173, 125, maxColorValue=255), rgb(132, 191, 48, 125, maxColorValue=255), rgb(48, 191, 167, 125, maxColorValue=255)))
Lengend <- mtext("Major Depression Severity", at = 0.1, cex = 1.5)

#Dimension 1 and 2
axis1 <- 1
axis2 <- 2
# generate the set of maps
BaseMap.Fi <- createFactorMap(resMCA$ExPosition.Data$fi,
                              axis1 = axis1, axis2 = axis2,
                              title = 'MCA Row Factor Scores Dimension 1 and 2',
                              col.points = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, cex = 1,
                              col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, text.cex = 0,
                              force = 2)
# add labels
labels4MCA <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
b0002.BaseMap.Fi <- BaseMap.Fi$zeMap + labels4MCA 
b0002.BaseMap.Fi

#Means for severity groups
group.mean <- aggregate(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
                     by = list(totalscore), # must be a list
                     mean)
# need to format the results from `aggregate` correctly
rownames(group.mean) <- group.mean[,1] # Use the first column as row names
fi.mean <- group.mean[,-1] # Exclude the first column

# get index for the first row of each group
grp.ind <- order(totalscore)[!duplicated(sort(totalscore))]
grp.col <- resMCA.inf$Fixed.Data$Plotting.Data$fi.col[grp.ind] # get the color
grp.name <- totalscore[grp.ind] # get the corresponding groups
names(grp.col) <- grp.name

fi.mean.plot <- createFactorMap(fi.mean[,c(1,2)],
                                alpha.points = 0.8,
                                col.points = grp.col[rownames(fi.mean)],
                                col.labels = grp.col[rownames(fi.mean)],
                                pch = 17,
                                cex = 3,
                                text.cex = 3)
fi.WithMean <- BaseMap.Fi$zeMap_background + BaseMap.Fi$zeMap_dots + fi.mean.plot$zeMap_dots + fi.mean.plot$zeMap_text + labels4MCA
fi.WithMean

# Bootstrap the Means
fi.boot <- Boot4Mean(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
                     design = totalscore,
                     niter = 1000)
# Bootstrap Plot of Dimension 1 and 2
bootCI4mean <- MakeCIEllipses(fi.boot$BootCube[,c(1:2),], # get the first two components
                              col = grp.col[rownames(fi.mean)])

fi.WithMeanCI <- BaseMap.Fi$zeMap_background + bootCI4mean + BaseMap.Fi$zeMap_dots + fi.mean.plot$zeMap_dots + fi.mean.plot$zeMap_text + labels4MCA
fi.WithMeanCI

######################################################################################################
#Dimension 2 and 3
axis1 = 2
axis2 = 3
# generate the set of maps
BaseMap.Fi2 <- createFactorMap(resMCA$ExPosition.Data$fi,
                              axis1 = axis1, axis2 = axis2,
                              title = 'MCA Row Factor Scores Dimensions 2 and 3',
                              col.points = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, cex = 1,
                              col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, text.cex = 0,
                              force = 2)
# add labels
labels4MCA2 <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
b0003.BaseMap.Fi2 <- BaseMap.Fi2$zeMap + labels4MCA2 
b0003.BaseMap.Fi2

#Means for severity groups
group.mean <- aggregate(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
                     by = list(totalscore), # must be a list
                     mean)
# need to format the results from `aggregate` correctly
rownames(group.mean) <- group.mean[,1] # Use the first column as row names
fi.mean <- group.mean[,-1] # Exclude the first column

# get index for the first row of each group
grp.ind <- order(totalscore)[!duplicated(sort(totalscore))]
grp.col <- resMCA.inf$Fixed.Data$Plotting.Data$fi.col[grp.ind] # get the color
grp.name <- totalscore[grp.ind] # get the corresponding groups
names(grp.col) <- grp.name

fi.mean.plot2 <- createFactorMap(fi.mean[,c(2,3)],
                                alpha.points = 0.8,
                                col.points = grp.col[rownames(fi.mean)],
                                col.labels = grp.col[rownames(fi.mean)],
                                pch = 17,
                                cex = 3,
                                text.cex = 3)
fi.WithMean2 <- BaseMap.Fi2$zeMap_background + BaseMap.Fi2$zeMap_dots + fi.mean.plot2$zeMap_dots + fi.mean.plot2$zeMap_text + labels4MCA2
fi.WithMean2

# Bootstrap the Means
fi.boot2 <- Boot4Mean(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
                     design = totalscore,
                     niter = 1000)
# Bootstrap Plot of Dimension 1 and 2
bootCI4mean2 <- MakeCIEllipses(fi.boot2$BootCube[,c(2:3),], names.of.factors = paste0('Dimension ',c(2,3)), # get the 2nd and 3rd components
                              col = grp.col[rownames(fi.mean)])

fi.WithMeanCI2 <- BaseMap.Fi2$zeMap_background + bootCI4mean2 + BaseMap.Fi2$zeMap_dots + fi.mean.plot2$zeMap_dots + fi.mean.plot2$zeMap_text + labels4MCA2
fi.WithMeanCI2

Column Loadings

#Colors for Variables (Grouped)
#ColorTheme <- prettyGraphsColorSelection(n.colors = 9)
t <- 1
for (k in 1:8) {
  p <- (k + (2*k))
  resMCA.inf$Fixed.Data$Plotting.Data$fj.col[t:p,] <- ColorTheme[k]
  t <- (t + 3)
}
resMCA.inf$Fixed.Data$Plotting.Data$fj.col[25:26,] <- ColorTheme[9]

#Dimension 1 and 2
axis1 <- 1
axis2 <- 2
# generate the set of maps
BaseMap.Fj <- createFactorMap(resMCA$ExPosition.Data$fj,
                              axis1 = axis1, axis2 = axis2,
                              title = 'MCA Column Loadings Dimension 1 and 2',
                              col.points = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, cex = 1,
                              col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, text.cex = 2.5,
                              force = 2)
# add labels
labels4MCAj <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
A0002.BaseMap.Fj <- BaseMap.Fj$zeMap + labels4MCAj 
A0002.BaseMap.Fj

lines4J <- addLines4MCA(resMCA$ExPosition.Data$fj, col4Var = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, size = .7)
A0002.BaseMap.Fj2 <- A0002.BaseMap.Fj + lines4J
A0002.BaseMap.Fj2

#######################################################################################################
#Dimension 3 and 4
axis1 = 2
axis2 = 3
# generate the set of maps
BaseMap.Fj2 <- createFactorMap(resMCA$ExPosition.Data$fj,
                              axis1 = axis1, axis2 = axis2,
                              title = 'MCA Column Loadings Dimensions 2 and 3',
                              col.points = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, cex = 1,
                              col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, text.cex = 2.5,
                              force = 2)
# add labels
labels4MCA2j <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
b0003.BaseMap.Fj2 <- BaseMap.Fj2$zeMap + labels4MCA2j 
b0003.BaseMap.Fj2

lines4J <- addLines4MCA(resMCA$ExPosition.Data$fj, col4Var = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, size = .7, axis_h = 2, axis_v = 3)
b0003.BaseMap.Fj2 <- b0003.BaseMap.Fj2 + lines4J
b0003.BaseMap.Fj2

Contributions

signed.ctrJ <- resMCA$ExPosition.Data$cj * sign(resMCA$ExPosition.Data$fj)

# plot contributions of columns for component 1
ctrJ.1 <- PrettyBarPlot2(signed.ctrJ[,1],
                         threshold = 1 / NROW(signed.ctrJ),
                         font.size = 3,
                         color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
                         ylab = 'Contributions',
                         ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns component 1')

# plot contributions of columns for component 2
ctrJ.2 <- PrettyBarPlot2(signed.ctrJ[,2],
                         threshold = 1 / NROW(signed.ctrJ),
                         font.size = 3,
                         color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
                         ylab = 'Contributions',
                         ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns component 2')

# plot contributions of columns for component 3
ctrJ.3 <- PrettyBarPlot2(signed.ctrJ[,3],
                         threshold = 1 / NROW(signed.ctrJ),
                         font.size = 3,
                         color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
                         ylab = 'Contributions',
                         ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns component 3')

grid.arrange(
    as.grob(ctrJ.1),as.grob(ctrJ.2),as.grob(ctrJ.3), 
    ncol = 1,nrow = 3,
    top = textGrob("Contributions", gp = gpar(fontsize = 18, font = 3))
  )

Ctr.IJ <- recordPlot() # you need this line to be able to save them in the end

Bootstrap Ratios

BR.J <- resMCA.inf$Inference.Data$fj.boots$tests$boot.ratios

laDim = 1
# Plot the bootstrap ratios for Dimension 1
ba002.BR1.J <- PrettyBarPlot2(BR.J[,laDim],
                        threshold = 2,
                        font.size = 3,
                   color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
                  ylab = 'Bootstrap ratios'
                  #ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns Dimension 1')

# Plot the bootstrap ratios for Dimension 2
laDim = 2
ba004.BR2.J <- PrettyBarPlot2(BR.J[,laDim],
                        threshold = 2,
                        font.size = 3,
                   color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
                  ylab = 'Bootstrap ratios'
                  #ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns Dimension 2')

# Plot the bootstrap ratios for Dimension 3
laDim = 3
ba004.BR3.J <- PrettyBarPlot2(BR.J[,laDim],
                        threshold = 2,
                        font.size = 3,
                   color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
                  ylab = 'Bootstrap ratios'
                  #ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns Dimension 3')

grid.arrange(
    as.grob(ba002.BR1.J),as.grob(ba004.BR2.J),as.grob(ba004.BR3.J),
    ncol = 1,nrow = 3,
    top = textGrob("Bootstrap ratios", gp = gpar(fontsize = 18, font = 3))
  )

BR.IJ <- recordPlot() # you need this line to be able to save them in the end

Save figures to PPT

The following chunk can give you a .pptx file with all your figures saved in the directory.

REMEMBER: Never use a screen shot

# Here we can save all figures to a PowerPoint
savedList <- saveGraph2pptx(file2Save.pptx = 'AllFigures_MCA', 
                            title = 'All Figures for MCA', 
                            addGraphNames = TRUE)

## Warning: File: AllFigures_MCA.pptx already exists.
##  Oldfile has been renamed: AllFigures_MCA-2019-10-13.pptx

Summary

When we interpret the factor scores and loadings together, the MCA revealed:

Component 1

Rows: Severity of depression group.

Cols: Severity of score.

Interpret: The more depressed the higher the score.

Component 2

Rows: Minimal and Mild depression vs moderately severe and severe.

Cols: Middle scores vs low and high scores.

Interpret: Mininmal and mild depression tend to have scores more in the middle as opposed to moderately severe and severe groups having more polarized scores.

Component 3

Rows: Moderately severe vs severe.

Columns: Moderate disturbances in speed vs high disturbances in speed.

Interpret: People with moderately severe and severe depression severity have moderate to high speed disturbances i.e. both groups experience feeling lethargic or extremely energtic.